home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Interactive 7
/
PC World Interactive 7.iso
/
program
/
pasprog.EXE
/
DISAS386.KOD
< prev
next >
Wrap
Text File
|
1980-01-10
|
45KB
|
1,724 lines
unit disas386;
{
(c)1994,95 GoRGoN Bilgisayar Yazilim ve Donanim Tic. ltd.
unit: Disas386
Desc: Disassembly for DEBUG purposes
vers: 1.52
notes:
- Slow and big!
- Covers 386 instructions only!
- Effective address mode not checked, 16 assumed!
- 32 bit displacements are not signed, implemented as EIP+disp in calls,jmps
implemented as + values in [ebx+AAA...
- math co (387) instructions not implemented.
- sometimes pist (or other strings) may be appended to instruction strings
(like o1st,o2st..). Do not count on any string var, use and parse dStr if
necessary.
history:
v1.00 6/94 initial version (BK)
v1.51 4/95 movzx,movsx bug corrected, some minor optimizations (BK)
v1.52 9/95 checked format for PS release (BK)
}
{
BU PROGRAM DENEME AMACLI YAZILMISTIR,
TICARI OLMAMAK KAYDIYLA DILEDIGINIZ GIBI KULLANABILIRSINIZ.
}
{---------------------------------------------------------------------------}
{ DEBUG I N T E R F A C E }
{---------------------------------------------------------------------------}
interface
var
dstr:string;{resulting disassembly string}
var
is : word;{should not be accessed normally}{instruction segment }
io : word;{should not be accessed normally}{instruction offset }
const
fulldisas:boolean=true;{long output string? }
var
inst : string;{should not be accessed normally}{instruction: MOV,XOR,XLAT}
pist : string;{should not be accessed normally}{segment override: ES:,DS:}
list : string;{should not be accessed normally}{prefix inst:LOCK,REP,REPZ}
o1st : string;{should not be accessed normally}{first operand }
o2st : string;{should not be accessed normally}{second operand,(w/third) }
procedure disasnext;
procedure disas(s,o:word);
procedure disasptr(p:pointer;c:byte);
procedure disasptrl(p:pointer;c:byte;l:byte);
function oldio:word;{should not be accessed normally}
{util use}
type
s2 = string[2];
s3 = string[3];
s4 = string[4];
s5 = string[5];
function hxb(x:byte):s2;
function hxw(x:word):s4;
function hxbs(x:shortint):s3;
function hxws(x:integer):s5;
implementation
type
s6 = string[6];
s7 = string[7];
const
reg08 : array[$0..$7]of s2
= ('al','cl','dl','bl','ah','ch','dh','bh');
reg16 : array[$0..$7]of s2
= ('ax','cx','dx','bx','sp','bp','si','di');
reg32 : array[$0..$7]of s3
= ('eax','ecx','edx','ebx','esp','ebp','esi','edi');
regCR : array[$0..$7]of s3
= ('cr0','CR?','cr2','cr3','CR?','CR?','CR?','CR?');
regDR : array[$0..$7]of s3
= ('dr0','dr1','dr2','dr3','DR?','DR?','dr6','dr7');
regTR : array[$0..$7]of s3
= ('TR?','TR?','TR?','TR?','TR?','TR?','tr6','tr7');
regsg : array[$0..$5]of s2
= ('es','cs','ss','ds','fs','gs');
sjmps : array[$0..$F]of s3
= ('jo','jno','jb','jnb','jz','jnz','ja','jna',
'js','jns','jp','jnp','jl','jnl','jg','jg');
loops : array[$0..$3]of s6
= ('loopne','loope','loop','jcxz');
shfts : array[$0..$7]of s3
= ('rol','ror','rcl','rcr','shl','shr','shl','sar');
addgr : array[$0..$7]of s3
= ('add','or','adc','sbb','and','sub','xor','cmp');
sets : array[$0..$F]of s5
= ('seto','setno','setb','setnb','setz','setnz','seta','setna',
'sets','setns','setp','setnp','setl','setnl','setg','setng');
a16m1 : array[$0..$7]of s7
= ('[bx+si]','[bx+di]','[bp+si]','[bp+di]','[si]','[di]','[','[bx]');
a16m2 : array[$0..$7]of s6
= ('[bx+si','[bx+di','[bp+si','[bp+di','[si','[di','[bp','[bx');
a32m1 : array[$0..$7]of s5
= ('[eax]','[ecx]','[edx]','[ebx]','','[','[esi]','[edi]');
a32m2 : array[$0..$7]of s4
= ('[eax','[ecx','[edx','[ebx','','[ebp','[esi','[edi');
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
{ utility functions }
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
{---------------------------------------------------------------------------}
{ returns 2 digit hex string of input byte }
{---------------------------------------------------------------------------}
function hxb(x:byte):s2;assembler;
asm
les di,@result
mov byte ptr es:[di],2
mov dl,x
mov al,dl
shr al,4
add al,90h
daa
adc al,40h
daa
mov byte ptr es:[di+1],al
mov al,dl
and al,0fh
add al,90h
daa
adc al,40h
daa
mov byte ptr es:[di+2],al
end;
{---------------------------------------------------------------------------}
{ returns 4 digit hex string of input word }
{---------------------------------------------------------------------------}
function hxw(x:word):s4;assembler;
asm
les di,@result
mov byte ptr es:[di],4
mov dx,x
mov al,dh
shr al,4
add al,90h
daa
adc al,40h
daa
mov byte ptr es:[di+1],al
mov al,dh
and al,0fh
add al,90h
daa
adc al,40h
daa
mov byte ptr es:[di+2],al
mov al,dl
shr al,4
add al,90h
daa
adc al,40h
daa
mov byte ptr es:[di+3],al
mov al,dl
and al,0fh
add al,90h
daa
adc al,40h
daa
mov byte ptr es:[di+4],al
end;
{---------------------------------------------------------------------------}
{ returns 3 digit signed hex string of input byte }
{---------------------------------------------------------------------------}
function hxbs(x:shortint):s3;assembler;
asm
mov ah,'+'
mov al,x
test al,80h
jz @pz
mov ah,'-'
neg al
@pz:
les di,@result
mov byte ptr es:[di],3
mov byte ptr es:[di+1],ah
mov ah,al
shr al,4
add al,90h
daa
adc al,40h
daa
mov byte ptr es:[di+2],al
mov al,ah
and al,0fh
add al,90h
daa
adc al,40h
daa
mov byte ptr es:[di+3],al
end;
{---------------------------------------------------------------------------}
{ returns 5 digit signed hex string of input word }
{---------------------------------------------------------------------------}
function hxws(x:integer):s5;assembler;
asm
mov ah,'+'
mov dx,x
test dx,8000h
jz @pz
mov ah,'-'
neg dx
@pz:
les di,@result
mov byte ptr es:[di],5
mov byte ptr es:[di+1],ah
mov al,dh
shr al,4
add al,90h
daa
adc al,40h
daa
mov byte ptr es:[di+2],al
mov al,dh
and al,0fh
add al,90h
daa
adc al,40h
daa
mov byte ptr es:[di+3],al
mov al,dl
shr al,4
add al,90h
daa
adc al,40h
daa
mov byte ptr es:[di+4],al
mov al,dl
and al,0fh
add al,90h
daa
adc al,40h
daa
mov byte ptr es:[di+5],al
end;
{---------------------------------------------------------------------------}
{ returns low nib }
{---------------------------------------------------------------------------}
function lnib(x:byte):byte;assembler;
asm
mov al,x
and al,0fh
end;
{---------------------------------------------------------------------------}
{ returns high nib }
{---------------------------------------------------------------------------}
function hnib(x:byte):byte;assembler;
asm
mov al,x
shr al,4
end;
{---------------------------------------------------------------------------}
{ returns mod / ss field }
{---------------------------------------------------------------------------}
function mo(x:byte):byte;assembler;
asm
mov al,x
shr al,6
end;
{---------------------------------------------------------------------------}
{ returns r/m / base field }
{---------------------------------------------------------------------------}
function rm(x:byte):byte;assembler;
asm
mov al,x
and al,07h
end;
{---------------------------------------------------------------------------}
{ returns reg / index field }
{---------------------------------------------------------------------------}
function rg(x:byte):byte;assembler;
asm
mov al,x
and al,38h
shr al,3
end;
{---------------------------------------------------------------------------}
{ instruction variables }
var
cd : byte; { current decoding, offset to instruction start }
wf : byte; { width field of the instruction 0=8,1=16,else none=1 }
ad : byte; { displacement size in bytes }
id : byte; { immediate data size in bytes }
ea32 : boolean; { effective address size prefix found, default 16 }
os32 : boolean; { operand size prefix found, default 16 assumed }
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
{ field decoders }
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
{---------------------------------------------------------------------------}
{ returns general register from regs field of mod reg r/m byte at is:io }
{---------------------------------------------------------------------------}
procedure regs(var s:string);
begin
if(wf=0) then s:=reg08[rg(mem[is:io+cd])]
else begin
if(os32) then s:=reg32[rg(mem[is:io+cd])]
else s:=reg16[rg(mem[is:io+cd])];
end;
end;
{---------------------------------------------------------------------------}
{ returns control register from regs field of mod reg r/m byte at is:io }
{---------------------------------------------------------------------------}
procedure cregs(var s:string);
begin
s:=regCR[rg(mem[is:io+cd])];
end;
{---------------------------------------------------------------------------}
{ returns debug register from regs field of mod reg r/m byte at is:io }
{---------------------------------------------------------------------------}
procedure dregs(var s:string);
begin
s:=regDR[rg(mem[is:io+cd])];
end;
{---------------------------------------------------------------------------}
{ returns test register from regs field of mod reg r/m byte at is:io }
{---------------------------------------------------------------------------}
procedure tregs(var s:string);
begin
s:=regTR[rg(mem[is:io+cd])];
end;
{---------------------------------------------------------------------------}
{ returns argument from mod r/m fields of mod regs r/m byte at is:io }
{---------------------------------------------------------------------------}
procedure modrm(var s:string);
var
x : byte;
tst : string;
{---------------------------------------------------}
{ returns register from r/m field }
{---------------------------------------------------}
procedure SelectReg;
begin
if(wf=0) then s:=reg08[rm(x)]
else begin
if(os32) then s:=reg32[rm(x)]
else s:=reg16[rm(x)];
end;
end;
{---------------------------------------------------}
{ returns scaled index in tst when sib is at is:io }
{---------------------------------------------------}
procedure scale;
begin
tst:='';
case rg(mem[is:io+cd]) of {index}
0: tst:='+(eax';
1: tst:='+(ecx';
2: tst:='+(edx';
3: tst:='+(ebx';
4: begin
tst:='';
if mo(mem[is:io+cd])<>0 then tst:='???';
exit;
end;
5: tst:='+(ebp';
6: tst:='+(esi';
7: tst:='+(edi';
end;{case}
case mo(mem[is:io+cd]) of {scale}
0: tst:=tst+')';
1: tst:=tst+'*2)';
2: tst:=tst+'*4)';
3: tst:=tst+'*8)';
end;{case}
end;
{---------------------------------------------------}
begin
x:=mem[is:io+cd];
if not(ea32) then begin
case mo(x) of
$0:begin
s:=a16m1[rm(x)];
if(rm(x)=6)then begin
s:=s+hxw(memw[is:io+cd+1])+']';
ad:=2;
end;
end;
$1:begin
s:=a16m2[rm(x)]+hxbs(shortint(mem[is:io+cd+1]))+']';
ad:=1;
end;
$2:begin
s:=a16m2[rm(x)]+hxws(integer(memw[is:io+cd+1]))+']';
ad:=2;
end;
$3:SelectReg;
end;{mo case}
end else begin {32 bit addressing mode}
case mo(x) of
$0:begin
case rm(x) of
0..3,
5..7:begin
s:=a32m1[rm(x)];
if(rm(x)=5)
then begin
s:=s+hxw(memw[is:io+cd+3])+hxw(memw[is:io+cd+1])+']';
ad:=4;
end;
end;
4:begin
inc(cd);
scale;
if(rm(mem[is:io+cd])<>5)
then begin
s:='['+reg32[rm(mem[is:io+cd])]+tst+']';
end
else begin
s:='['+hxw(memw[is:io+cd+3])+hxw(memw[is:io+cd+1])+tst+']';
ad:=4;
end;
dec(cd);
inc(id);
end;
end;{case}
end;
$1:begin
if(rm(x)<>4)
then begin
s:=a32m2[rm(x)]+hxbs(shortint(mem[is:io+cd+1]))+']';
ad:=1;
end
else begin
inc(cd);
scale;
s:='['+reg32[rm(mem[is:io+cd])]+tst
+hxbs(shortint(mem[is:io+cd+1]))+']';
ad:=1;
dec(cd);
inc(id);
end;
end;
$2:begin
if(rm(x)<>4)
then begin
s:=a32m2[rm(x)]+'+'+hxw(memw[is:io+cd+3])+hxw(memw[is:io+cd+1])+']';
ad:=4;
end
else begin
inc(cd);scale;
s:='['+reg32[rm(mem[is:io+cd])]+tst+'+'
+hxw(memw[is:io+cd+3])+hxw(memw[is:io+cd+1])+']';
ad:=4;
dec(cd);
inc(id);
end;
end;
$3:SelectReg;
end;{mo case}
end;{32?16}
s:=pist+s;
pist:='';
end;
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
{ Instruction Crackers }
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
procedure EbGb(const s:string);
begin
inst:=s;
inc(cd);
wf:=0;
modrm(o1st);
regs(o2st);
end;
{--------------------------------------------------------------------------}
procedure EvGv(const s:string);
begin
inst:=s;
inc(cd);
modrm(o1st);
regs(o2st);
end;
{--------------------------------------------------------------------------}
procedure GbEb(const s:string);
begin
inst:=s;
inc(cd);
wf:=0;
modrm(o2st);
regs(o1st);
end;
{--------------------------------------------------------------------------}
procedure GvEv(const s:string);
begin
inst:=s;
inc(cd);
modrm(o2st);
regs(o1st);
end;
{--------------------------------------------------------------------------}
procedure ALIb(const s:string);
begin
inst:=s;
o1st:='al';
id:=1;
o2st:=hxb(mem[is:io+cd+1]);
end;
{--------------------------------------------------------------------------}
procedure eAXIv(const s:string);
begin
inst:=s;
if(not(os32))
then begin
id:=2;
o1st:='ax';
o2st:=hxw(memw[is:io+cd+1]);
end
else begin
id:=4;
o1st:='eax';
o2st:=hxw(memw[is:io+cd+3])+hxw(memw[is:io+cd+1]);
end;
end;
{--------------------------------------------------------------------------}
procedure eAXIb(const s:string);
begin
inst:=s;
id:=1;
o2st:=hxb(mem[is:io+cd+1]);
if not(os32) then o1st:='ax'
else o1st:='eax';
end;
{--------------------------------------------------------------------------}
procedure Ap(const s:string);
begin
inst:=s;
if(not(os32))
then begin
id:=4;
o1st:=hxw(memw[is:io+cd+3])+':'+hxw(memw[is:io+cd+1]);
end
else begin
id:=6;
o1st:=hxw(memw[is:io+cd+5])+':'
+hxw(memw[is:io+cd+3])+hxw(memw[is:io+cd+1]);
end;
end;
{--------------------------------------------------------------------------}
procedure Jb(const s:string);
begin
inst:=s;
id:=1;
o1st:=hxw(io+2+shortint(mem[is:io+cd+1]));
end;
{--------------------------------------------------------------------------}
procedure Jv(const s:string);
begin
inst:=s;
if(not(os32))
then begin
id:=2;
o1st:=hxw(io+3+integer(memw[is:io+cd+1]));
end
else begin
id:=4;
o1st:='EIP+'+hxw(memw[is:io+cd+3])+hxw(memw[is:io+cd+1]);
end;
end;
{--------------------------------------------------------------------------}
procedure Jv2(const s:string);
begin
inst:=s;
if(not(os32))
then begin
id:=2;
o1st:=hxw(io+4+integer(memw[is:io+cd+1]));
end
else begin
id:=4;
o1st:='EIP+'+hxw(memw[is:io+cd+3])+hxw(memw[is:io+cd+1]);
end;
end;
{--------------------------------------------------------------------------}
procedure simple1(const s:string);
begin
inst:=s;
end;
{--------------------------------------------------------------------------}
procedure simple2(const s,p1:string);
begin
inst:=s;
o1st:=p1;
end;
{--------------------------------------------------------------------------}
procedure simple3(const s,p1,p2:string);
begin
inst:=s;
o1st:=p1;
o2st:=p2;
end;
{--------------------------------------------------------------------------}
procedure swapp;
var
t:string;
begin
t:=o1st;
o1st:=o2st;
o2st:=t;
end;
{--------------------------------------------------------------------------}
procedure segop(const s:string);
begin
pist:=pist+s;
inc(cd);
end;
{--------------------------------------------------------------------------}
procedure legop(const s:string);
begin
list:=s;
inc(cd);
end;
{--------------------------------------------------------------------------}
procedure genreg1;
begin
if not(os32) then o1st:=reg16[lnib(mem[is:io+cd]) mod 8]
else o1st:=reg32[lnib(mem[is:io+cd]) mod 8];
end;
{--------------------------------------------------------------------------}
procedure genreg2;
begin
if not(os32) then o2st:=reg16[lnib(mem[is:io+cd]) mod 8]
else o2st:=reg32[lnib(mem[is:io+cd]) mod 8];
end;
{--------------------------------------------------------------------------}
procedure eAX1;
begin
if not(os32) then o1st:='ax'
else o1st:='eax';
end;
{--------------------------------------------------------------------------}
procedure eAX2;
begin
if not(os32) then o2st:='ax'
else o2st:='eax';
end;
{--------------------------------------------------------------------------}
procedure width1(const s,w:string);
begin
if os32 then inst:=w
else inst:=s;
end;
{--------------------------------------------------------------------------}
procedure byteo1;
begin
if o1st[length(o1st)]=']' then o1st:='byte ptr '+o1st;
end;
{--------------------------------------------------------------------------}
procedure wordo1;
begin
if(o1st[length(o1st)]=']')
then if os32 then o1st:='dword ptr '+o1st
else o1st:='word ptr '+o1st;
end;
{--------------------------------------------------------------------------}
procedure dwordo1;
begin
if(o1st[length(o1st)]=']')
then if os32 then o1st:='16:32 ptr '+o1st
else o1st:='dword ptr '+o1st;
end;
{--------------------------------------------------------------------------}
procedure dwordo2;
begin
if(o2st[length(o2st)]=']')
then if os32 then o2st:='16:32 ptr '+o2st
else o2st:='dword ptr '+o2st;
end;
{--------------------------------------------------------------------------}
procedure memchk2;
begin
if(o2st[length(o2st)]<>']')
then begin
inst:='';
o1st:='';
o2st:='';
dec(cd);
end;{ad is not important, if it is mem it is ok}
end;
{--------------------------------------------------------------------------}
procedure memchk2r;
begin
if(o1st[length(o2st)]=']')
then begin
inst:='';
o1st:='';
o2st:='';
dec(cd,ad);
ad:=0;
end;{ad is important! }
end;
{--------------------------------------------------------------------------}
procedure Ebi(const s:string);
begin
inst:=s;
wf:=0;
modrm(o1st);
byteo1;
end;
{--------------------------------------------------------------------------}
procedure Evi(const s:string);
begin
inst:=s;
modrm(o1st);
wordo1;
end;
{--------------------------------------------------------------------------}
procedure EbIbi(const s:string);
begin
inst:=s;
id:=1;
wf:=0;
modrm(o1st);
byteo1;
o2st:=hxb(mem[is:io+cd+ad+1]);
end;
{--------------------------------------------------------------------------}
procedure EvIvi(const s:string);
begin
inst:=s;
modrm(o1st);
if(not(os32))
then begin
id:=2;
o2st:=hxw(memw[is:io+cd+ad+1]);
if o1st[length(o1st)]=']' then o1st:='word ptr '+o1st;
end
else begin
id:=4;
if o1st[length(o1st)]=']' then o1st:='dword ptr '+o1st;
o2st:=hxw(memw[is:io+cd+ad+3])+
hxw(memw[is:io+cd+ad+1]);
end;
end;
{--------------------------------------------------------------------------}
procedure EvIbi(const s:string);
begin
inst:=s;
modrm(o1st);
id:=1;
wordo1;
o2st:=hxb(mem[is:io+cd+ad+1]);
end;
{--------------------------------------------------------------------------}
procedure eP(const s:string);
begin
inst:=s;
modrm(o1st);
dwordo1;
end;
{--------------------------------------------------------------------------}
procedure movALOb;
begin
inst:='mov';
o1st:='al';
if(ea32)
then begin
id:=4;
o2st:='['+hxw(memw[is:io+cd+3])+hxw(memw[is:io+cd+1])+']';
end
else begin
id:=2;
o2st:='['+hxw(memw[is:io+cd+1])+']';
end;
if(pist<>'')
then begin
o2st:=pist+o2st;
pist:='';
end;
end;
{--------------------------------------------------------------------------}
procedure moveAXOv;
begin
inst:='mov';
if os32 then o1st:='eax'
else o1st:='ax';
if(ea32)
then begin
id:=4;
o2st:='['+hxw(memw[is:io+cd+3])+hxw(memw[is:io+cd+1])+']';
end
else begin
id:=2;
o2st:='['+hxw(memw[is:io+cd+1])+']';
end;
if(pist<>'')
then begin
o2st:=pist+o2st;
pist:='';
end;
end;
{--------------------------------------------------------------------------}
procedure Iv(const s:string);
begin
inst:=s;
if(os32)
then begin
id:=4;
o1st:=hxw(memw[is:io+cd+3])+hxw(memw[is:io+cd+1]);
end
else begin
id:=2;
o1st:=hxw(memw[is:io+cd+1]);
end;
end;
{--------------------------------------------------------------------------}
procedure Ib(const s:string);
begin
inst:=s;
id:=1;
o1st:=hxb(mem[is:io+cd+1]);
end;
{--------------------------------------------------------------------------}
procedure Ewi(const s:string);
begin
inst:=s;
modrm(o1st);
if o1st[length(o1st)]=']' then o1st:='word ptr '+o1st;
end;
{--------------------------------------------------------------------------}
procedure Ms(const s:string);
begin
inst:=s;
modrm(o1st);
if(o1st[length(o1st)]<>']')
then begin
inst:='';
o1st:='';
o2st:='';
dec(cd);
end;{ad is not important, if it is mem it is ok}
end;
{--------------------------------------------------------------------------}
procedure CdRd(const s:string);
begin
os32:=true;
inst:=s;
inc(cd);
cregs(o1st);
modrm(o2st);
if o2st[length(o2st)]=']' then o2st:=o2st+'?';
end;
{--------------------------------------------------------------------------}
procedure DdRd(const s:string);
begin
os32:=true;
inst:=s;
inc(cd);
dregs(o1st);
modrm(o2st);
if o2st[length(o2st)]=']' then o2st:=o2st+'?';
end;
{--------------------------------------------------------------------------}
procedure TdRd(const s:string);
begin
os32:=true;
inst:=s;
inc(cd);
tregs(o1st);
modrm(o2st);
if o2st[length(o2st)]=']' then o2st:=o2st+'?';
end;
{--------------------------------------------------------------------------}
procedure GvEb(const s:string);
begin
inst:=s;
inc(cd);
regs(o1st);
os32:=false;
modrm(o2st);
if o2st[length(o2st)]=']' then o2st:='byte ptr '+o2st;
end;
{--------------------------------------------------------------------------}
procedure GvEw(const s:string);
begin
inst:=s;
inc(cd);
regs(o1st);
os32:=false;
modrm(o2st);
if o2st[length(o2st)]=']' then o2st:='word ptr '+o2st;
end;
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
{ two byte inst decode }
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
procedure twobyte;
begin
inc(cd);
case hnib(mem[is:io+cd]) of
$0:begin
case lnib(mem[is:io+cd]) of
$0:begin
inc(cd);
case rg(mem[is:io+cd]) of
0:Ewi('sldt');
1:Ewi('str');
2:Ewi('lldt');
3:Ewi('ltr');
4:Ewi('verr');
5:Ewi('verw');
6:dec(cd);
7:dec(cd);
end;
end;
$1:begin
inc(cd);
case rg(mem[is:io+cd]) of
0:Ms('sgdt');
1:Ms('sidt');
2:Ms('lgdt');
3:Ms('lidt');
4:Ewi('smsw');
5:dec(cd);
6:Ewi('lmsw');
7:dec(cd);
end;
end;
$2:GvEv('lar');
$3:GvEv('lsl');
$5:simple1('loadall');
$6:simple1('clts');
end;
end;
$2:begin
case lnib(mem[is:io+cd]) of
$0:CdRd('mov');
$1:DdRd('mov');
$2:begin
CdRd('mov');
swapp;
end;
$3:begin
DdRd('mov');
swapp;
end;
$4:TdRd('mov');
$6:begin
TdRd('mov');
swapp;
end;
end;{case}
end;
$8:Jv2(sjmps[lnib(mem[is:io+cd])]);
$9:begin
inc(cd);
Ebi(sets[lnib(mem[is:io+cd-1])]);
end;
$A:begin
case lnib(mem[is:io+cd]) of
$0:simple2('push','fs');
$1:simple2('pop','fs');
$3:EvGv('bt');
$4:begin
inst:='shld';
inc(cd);
modrm(o1st);
regs(o2st);
id:=1;
o2st:=o2st+','+hxb(mem[is:io+cd+ad+1]);
end;
$5:begin
inst:='shld';
inc(cd);
modrm(o1st);
regs(o2st);
o2st:=o2st+',cl';
end;
$8:simple2('push','gs');
$9:simple2('pop','gs');
$B:EvGv('bts');
$C:begin
inst:='shrd';
inc(cd);
modrm(o1st);
regs(o2st);
id:=1;
o2st:=o2st+','+hxb(mem[is:io+cd+ad+1]);end;
$D:begin
inst:='shrd';
inc(cd);
modrm(o1st);
regs(o2st);
o2st:=o2st+',cl';
end;
$F:GvEv('imul');
end;{case}
end;
$B:begin
case lnib(mem[is:io+cd]) of
$2:begin
inst:='lss';
inc(cd);
modrm(o2st);
regs(o1st);
dwordo2;
memchk2;
end;
$3:EvGv('btr');
$4:begin
inst:='lfs';
inc(cd);
modrm(o2st);
regs(o1st);
dwordo2;memchk2;
end;
$5:begin
inst:='lgs';
inc(cd);
modrm(o2st);
regs(o1st);
dwordo2;memchk2;
end;
$6:GvEb('movzx');
$7:GvEw('movzx');
$A:begin
inc(cd);
case rg(mem[is:io+cd]) of
0..3:dec(cd);
4:EvIbi('bt');
5:EvIbi('bts');
6:EvIbi('btr');
7:EvIbi('btc');
end;{case}
end;
$B:EvGv('btc');
$C:GvEv('bsf');
$D:GvEv('bsr');
$E:GvEb('movsx');
$F:GvEw('movsx');
end;{case}
end;
end;
if(inst='') then dec(cd);
end;
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
{ One byte inst decode }
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
procedure onebyte;
label
again;
var
cm:byte;
begin
cd := 0;
wf := 1; {none}
ad := 0;
id := 0;
ea32 := false; {should be checked for default!}
os32 := false;
inst := '';
pist := '';
list := '';
o1st := '';
o2st := '';
again:
cm := mem[is:io+cd];
case hnib(cm) of
{///////////////////////////////////////////////////////////////////////////}
$0:begin
case lnib(cm) of
$0:EbGb('add');
$1:EvGv('add');
$2:GbEb('add');
$3:GvEv('add');
$4:ALIb('add');
$5:eAXIv('add');
$6:simple2('push','es');
$7:simple2('pop','es');
$8:EbGb('or');
$9:EvGv('or');
$A:GbEb('or');
$B:GvEv('or');
$C:ALIb('or');
$D:eAXIv('or');
$E:simple2('push','cs');
$F:twobyte;
end;
end;{0}
{///////////////////////////////////////////////////////////////////////////}
$1:begin
case lnib(cm) of
$0:EbGb('adc');
$1:EvGv('adc');
$2:GbEb('adc');
$3:GvEv('adc');
$4:ALIb('adc');
$5:eAXIv('adc');
$6:simple2('push','ss');
$7:simple2('pop','ss');
$8:EbGb('sbb');
$9:EvGv('sbb');
$A:GbEb('sbb');
$B:GvEv('sbb');
$C:ALIb('sbb');
$D:eAXIv('sbb');
$E:simple2('push','ds');
$F:simple2('pop','ds');
end;
end;{1}
{///////////////////////////////////////////////////////////////////////////}
$2:begin
case lnib(cm) of
$0:EbGb('and');
$1:EvGv('and');
$2:GbEb('and');
$3:GvEv('and');
$4:ALIb('and');
$5:eAXIv('and');
$6:begin
segop('es:');
goto again;
end;
$7:simple1('daa');
$8:EbGb('sub');
$9:EvGv('sub');
$A:GbEb('sub');
$B:GvEv('sub');
$C:ALIb('sub');
$D:eAXIv('sub');
$E:begin
segop('cs:');
goto again;
end;
$F:simple1('das');
end;
end;{2}
{///////////////////////////////////////////////////////////////////////////}
$3:begin
case lnib(cm) of
$0:EbGb('xor');
$1:EvGv('xor');
$2:GbEb('xor');
$3:GvEv('xor');
$4:ALIb('xor');
$5:eAXIv('xor');
$6:begin
segop('ss:');
goto again;
end;
$7:simple1('aaa');
$8:EbGb('cmp');
$9:EvGv('cmp');
$A:GbEb('cmp');
$B:GvEv('cmp');
$C:ALIb('cmp');
$D:eAXIv('cmp');
$E:begin
segop('ds:');
goto again;
end;
$F:simple1('aas');
end;
end;{3}
{///////////////////////////////////////////////////////////////////////////}
$4:begin
case lnib(cm) of
$0..$7:simple1('inc');
$7..$F:simple1('dec');
end;
genreg1;
end;{4}
{///////////////////////////////////////////////////////////////////////////}
$5:begin
case lnib(cm) of
$0..$7:simple1('push');
$7..$F:simple1('pop');
end;
genreg1;
end;{5}
{///////////////////////////////////////////////////////////////////////////}
$6:begin
case lnib(cm) of
$0:width1('pusha','pushad');
$1:width1('popa','popad');
$2:begin
inst:='bound';
inc(cd);
wf:=1;
regs(o1st);
modrm(o2st);
memchk2;
end;
$3:begin
inst:='arpl';
inc(cd);
wf:=1;
regs(o2st);
modrm(o1st);
memchk2r;
end;
$4:begin
segop('fs:');
goto again;
end;
$5:begin
segop('gs:');
goto again;
end;
$6:begin
os32:=not(os32);
inc(cd);
goto again;
end;
$7:begin
ea32:=not(ea32);
inc(cd);
goto again;
end;
$8:Iv('push');
$9:begin
inst:='imul';
wf:=1;
inc(cd);
regs(o1st);
modrm(o2st);
if os32
then begin
id:=4;
o2st:=o2st+','
+hxw(memw[is:io+ad+cd+3])+hxw(memw[is:io+ad+cd+1]);
end
else begin
id:=2;
o2st:=o2st+','+hxw(memw[is:io+ad+cd+1]);
end;
end;
$A:Ib('push');
$B:begin
inst:='imul';
wf:=1;
inc(cd);
regs(o1st);
modrm(o2st);
id:=1;
o2st:=o2st+','+hxb(mem[is:io+cd+ad+1]);
end;
$C:simple1('insb');
$D:width1('insw','insd');
$E:simple1('outsb');
$F:width1('outsw','outsd');
end;{case}
end;{6}
{///////////////////////////////////////////////////////////////////////////}
$7: Jb(sjmps[lnib(cm)]);
{///////////////////////////////////////////////////////////////////////////}
$8:begin
case lnib(cm) of
$0:begin
inc(cd);
EbIbi(addgr[rg(mem[is:io+cd])]);
end;
$1:begin
inc(cd);
EvIvi(addgr[rg(mem[is:io+cd])]);
end;
$2:begin
wf:=0;
inc(cd);
modrm(o1st);
id:=1;{weird opcode!}
inst:=addgr[rg(mem[is:io+cd])];
byteo1;
o2st:=hxw(shortint(mem[is:io+cd+ad+1]));
end;
$3:begin
inc(cd);
EvIbi(addgr[rg(mem[is:io+cd])]);
end;
$4:EbGb('test');
$5:EvGv('test');
$6:EbGb('xchg');
$7:EvGv('xchg');
$8:EbGb('mov');
$9:EvGv('mov');
$A:GbEb('mov');
$B:GvEv('mov');
$C:begin
inst:='mov';
inc(cd);
modrm(o1st);
o2st:=regsg[rg(mem[is:io+cd])];
end;
$D:begin
GvEv('lea');
memchk2;
end;
$E:begin
inst:='mov';
inc(cd);
modrm(o2st);
o1st:=regsg[rg(mem[is:io+cd])];
end;
$F:begin
inc(cd);
Evi('pop');
end;
end;{case}
end;{8}
{///////////////////////////////////////////////////////////////////////////}
$9:begin
case lnib(cm) of
$0:simple1('nop');
$1..$7:begin
simple1('xchg');
eAX1;
genreg2;
end;
$8:width1('cbw','cwde');
$9:width1('cwd','cdq');
$A:Ap('call');
$B:simple1('wait');
$C:width1('pushf','pushfd');
$D:width1('popf','popfd');
$E:simple1('sahf');
$F:simple1('lahf');
end;{case}
end;{9}
{///////////////////////////////////////////////////////////////////////////}
$A:begin
case lnib(cm) of
$0:movALOb;
$1:moveAXOv;
$2:begin
movALOb;
swapp;
end;
$3:begin
moveAXOv;
swapp;
end;
$4:simple1('movsb');
$5:width1('movsw','movsd');
$6:simple1('cmpsb');
$7:width1('cmpsw','cmpsd');
$8:ALIb('test');
$9:eAXIv('test');
$A:simple1('stosb');
$B:width1('stosw','stosd');
$C:simple1('lodsb');
$D:width1('lodsw','lodsd');
$E:simple1('scasb');
$F:width1('scasw','scasd');
end;{case}
end;{A}
{///////////////////////////////////////////////////////////////////////////}
$B:begin
case lnib(cm) of
$0..$7:begin
inst:='mov';id:=1;
o1st:=reg08[lnib(mem[is:io+cd])];
o2st:=hxb(mem[is:io+cd+1]);
end;
$8..$F:begin
inst:='mov';
if os32
then begin
id:=4;
o1st:=reg32[lnib(mem[is:io+cd])mod 8];
o2st:=hxw(memw[is:io+cd+3])+hxw(memw[is:io+cd+1]);
end
else begin
id:=2;
o1st:=reg16[lnib(mem[is:io+cd])mod 8];
o2st:=hxw(memw[is:io+cd+1]);
end;
end;
end;{case}
end;{B}
{///////////////////////////////////////////////////////////////////////////}
$C:begin
case lnib(cm) of
$0:begin
inc(cd);
EbIbi(shfts[rg(mem[is:io+cd])]);
end;
$1:begin
inc(cd);
EvIbi(shfts[rg(mem[is:io+cd])]);
end;
$2:begin
inst:='ret';
id:=2;
o1st:=hxw(memw[is:io+cd+1]);
end;
$3:simple1('ret');
$4:begin
inst:='les';
inc(cd);
modrm(o2st);
regs(o1st);
dwordo2;
memchk2;
end;
$5:begin
inst:='lds';
inc(cd);
modrm(o2st);
regs(o1st);
dwordo2;
memchk2;
end;
$6:begin
inc(cd);
EbIbi('mov');
end;
$7:begin
inc(cd);
EvIvi('mov');
end;
$8:begin
inst:='enter';
id:=3;
o1st:=hxw(memw[is:io+cd+1]);
o2st:=hxb(mem [is:io+cd+3]);
end;
$9:simple1('leave');
$A:begin
inst:='retf';
id:=2;
o1st:=hxw(memw[is:io+cd+1]);
end;
$B:simple1('retf');
$C:simple1('int3');
$D:begin
inst:='int';
id:=1;
o1st:=hxb(mem[is:io+cd+1]);
end;
$E:simple1('into');
$F:width1('iret','iretd');
end;
end;{C}
{///////////////////////////////////////////////////////////////////////////}
$D:begin
case lnib(cm) of
$0:begin
inc(cd);
Ebi(shfts[rg(mem[is:io+cd])]);
o2st:= '1';
end;
$1:begin
inc(cd);
Evi(shfts[rg(mem[is:io+cd])]);
o2st:= '1';
end;
$2:begin
inc(cd);
Ebi(shfts[rg(mem[is:io+cd])]);
o2st:='cl';
end;
$3:begin
inc(cd);
Evi(shfts[rg(mem[is:io+cd])]);
o2st:='cl';
end;
$4:begin
inst:='aam';
inc(cd);
if(mem[is:io+cd]<>$0A)
then begin
inst:='';
dec(cd);
end;
end;
$5:begin
inst:='aad';
inc(cd);
if(mem[is:io+cd]<>$0A)
then begin
inst:='';
dec(cd);
end;
end;
$6:begin
end;
$7:simple1('xlat');
$8..$F:begin
inst:='esc';
end;
end;{case}
end;{D}
{///////////////////////////////////////////////////////////////////////////}
$E:begin
case lnib(cm) of
0..3:Jb(loops[lnib(mem[is:io+cd])]);
$4:ALIb('in');
$5:eAXIb('in');
$6:begin
ALIb('out');
swapp;
end;
$7:begin
eAXIb('out');
swapp;
end;
$8:Jv('call');
$9:Jv('jmp');
$A:Ap('jmp');
$B:Jb('jmp');
$C:simple3('in','al','dx');
$D:begin
simple3('in','','dx');
eAX1;
end;
$E:simple3('out','dx','al');
$F:begin
simple2('out','dx');
eAX2;
end;
end;{case}
end;{E}
{///////////////////////////////////////////////////////////////////////////}
$F:begin
case lnib(cm) of
$0:begin
legop('lock ');
goto again;
end;
$2:begin
legop('repne ');
goto again;
end;
$3:begin
legop('rep ');
goto again;
end;
$4:simple1('hlt');
$5:simple1('cmc');
$6:begin
inc(cd);
case rg(mem[is:io+cd]) of
0,1:EbIbi('test');
2:Ebi('not');
3:Ebi('neg');
4:Ebi('mul');
5:Ebi('imul');
6:Ebi('div');
7:Ebi('idiv');
end;
end;
$7:begin
inc(cd);
case rg(mem[is:io+cd]) of
0,1:EvIvi('test');
2:Evi('not');
3:Evi('neg');
4:Evi('mul');
5:Evi('imul');
6:Evi('div');
7:Evi('idiv');
end;
end;
$8:simple1('clc');
$9:simple1('stc');
$A:simple1('cli');
$B:simple1('sti');
$C:simple1('cld');
$D:simple1('std');
$E:begin
inc(cd);
if(rg(mem[is:io+cd])=0)then Ebi('inc')
else if(rg(mem[is:io+cd])=1)then Ebi('dec')
else begin
inst:='';
o1st:='';
o2st:='';
dec(cd);
end;
end;
$F:begin
inc(cd);
case rg(mem[is:io+cd]) of
0:Evi('inc');
1:Evi('dec');
2:Evi('call');
3:eP('call');
4:Evi('jmp');
5:eP('jmp');
6:Evi('push');
7:dec(cd);
end;
end;
end;{case}
end;{F}
{///////////////////////////////////////////////////////////////////////////}
end;{case hnib}
if(inst='')then
if((pist<>'')or(list<>''))
then begin
inst:=list+pist;
list:='';
pist:='';
dec(cd);
end
else begin
inst:='db';
o1st:=hxb(mem[is:io]);
end;
io:=io+cd+ad+id+1;
end;
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
{
returns previous io(instruction offset)
}
function oldio:word;
begin
oldio:=io-(cd+ad+id+1);
end;
{
Disassembly
to global string dstr
from global is:io
}
procedure disasnext;
var
t:word;
begin
if fulldisas then dstr:=hxw(is)+':'
else dstr:='';
dstr:=dstr+hxw(io)+' ';
onebyte;
if(fulldisas)
then begin
t:=io-(cd+ad+id+1);
while(t<>io) do
begin
dstr:=dstr+hxb(mem[is:t]);
inc(t);
end;
for t:=1 to 29-length(dstr) do dstr:=dstr+' ';
end;
dstr:=dstr+list+inst+' '+pist+o1st;
if(length(o2st)<>0) then dstr:=dstr+','+o2st;
end;
{
inits is:io and does one instruction disassembly
}
procedure disas(s,o:word);
begin
is:=s;
io:=o;
disasnext;
end;
{
writeln disassembly
p is pointer to start
c is number of lines/instructions
}
procedure disasptr(p:pointer;c:byte);
var x:byte;
begin
if c=0 then c:=24;
disas(seg(p^),ofs(p^));
writeln(dstr);
for x:=2 to c do
begin
disasnext;
writeln(dstr);
end;
end;
{
writeln disassembly
p is pointer to start
c is number of lines/instructions
l is string max length
}
procedure disasptrl(p:pointer;c:byte;l:byte);
var
x:byte;
t:byte;
begin
if c=0 then c:=24;
disas(seg(p^),ofs(p^));
if(l<>0)
then if(dstr[0]>chr(l))
then dstr[0]:=chr(l);
for t:=1 to l-length(dstr) do dstr:=dstr+' ';
writeln(dstr);
for x:=2 to c do
begin
disasnext;
if(l<>0)
then if(dstr[0]>chr(l))
then dstr[0]:=chr(l);
for t:=1 to l-length(dstr) do dstr:=dstr+' ';
write(dstr);
if(x<>c) then writeln;
end;
end;
end.